home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / PPC source / pFiles < prev    next >
Text File  |  1998-06-12  |  16KB  |  689 lines
  1. ¥ Files  - file object and loader
  2.  
  3. -39        constant    EOF            ¥ EOF error return
  4. -43        constant    FNF            ¥ File not found ditto
  5.  
  6. -300     constant    FILE-MARK
  7.  
  8. ¥ Marks the start of a loaded file - we plant some useful info there.
  9. ¥ We put the file name in the dic as if it's a definition name, but use
  10. ¥ file-mark as a "handler code".  Then after that we put the useful info.
  11. ¥ See extrasMod.
  12.  
  13. false    value    ASYNCH?
  14. false    value    ENDLOAD?
  15. false    value    LOG?
  16.  
  17.     0    value    OPEN_CNT
  18.     0    value    CLOSE_ERR_CNT
  19.  
  20. forward    CREATE_LOG
  21. forward    WRITE_LOG
  22. forward OK?
  23.  
  24.     string  $tmp
  25.     string    $marker
  26.  
  27. sysCall  SFGetFile
  28. sysCall  SFPutFile
  29.  
  30. sysCall     PBOpenSync
  31. sysCall  PBCloseSync
  32. sysCall  PBCreateSync
  33. sysCall  PBDeleteSync
  34.  
  35. sysCall  PBReadSync
  36. sysCall  PBWriteSync
  37.  
  38. sysCall  PBSetFPosSync
  39. sysCall  PBSetEOFSync
  40. sysCall  PBGetEOFSync
  41.  
  42. sysCall  PBHGetFInfoSync
  43. sysCall  PBHSetFInfoSync
  44. sysCall  PBRenameSync
  45. sysCall  PBFlushVolSync
  46.  
  47.  
  48. : ?DISABLE_ACTW
  49.             ¥ deactivates the front window if it's one of ours.  Call before
  50.             ¥  putting up a dialog, since that doesn't automatically cause a
  51.             ¥  deactivate event, for some strange reason.
  52.  
  53.     actW IF  disable: [ actW ]  THEN  ;
  54.  
  55. (* ***** don't want asynch stuff at this stage on the PPC, since it would
  56.     involve us in all that nasty UPP stuff...
  57.     
  58. : ASYNCH    true -> asynch?  ;
  59.  
  60. : IOWAIT    BEGIN  busy  0EXIT  pause  AGAIN   ;
  61.  
  62. : (ASY)        ¥ ( fcb -- )  Sets up for a low-level asynchronous read or write.
  63.     IOwait
  64.     -> busy  setCP  ;
  65. *)
  66.  
  67. : VOLNAME?  { str -- b } 
  68.     reset: [ str ]
  69.     58 str chsearch: [ str ]
  70.     NIF  false  EXIT  THEN
  71.     lim: [ str ]  2 >=  ;
  72.  
  73.  
  74. forward  OPEN_WITH_PATHS
  75.  
  76. false    value    USE_PATHS?
  77.  
  78. true    constant    HFS?            ¥ always true on PPC
  79.  
  80. variable    MyDocName    28 allotx
  81.  
  82. : MyDoc        ¥ ( -- addr len )
  83.     MyDocName  count  ;
  84.  
  85.  
  86. ¥ Standard file package support
  87.  
  88. : SFLOC  {  ¥ wd ht -- wd ht }
  89.         ¥ Computes screen coordinates for top left of
  90.         ¥ SF dialog box.  Centers the box horizontally, and a bit above
  91.         ¥ the center vertically.
  92.     screenbits  -> ht  -> wd  2drop
  93.     ht 3 /  80 -  0 max  -> ht
  94.     wd 2/  170 -  0 max  -> wd
  95.     wd ht  ;
  96.  
  97.  
  98. :class     SFrec    super{ object } 
  99.  
  100. 68k_record
  101. {    byte        Good
  102.     byte        count            ¥ actually not used
  103.     var            fType
  104.     int            vRefNum
  105.     int            Version
  106.  64    bytes        Filename        ¥ max size is 64
  107. }
  108. 4    ordered-col    fTypes            ¥ list of filetypes
  109.  
  110.  
  111. :m GetVRefNum:    get: vRefNum   ;m
  112. :m GetName:        addr: FileName   ;m
  113.  
  114. :m CALL:    ¥ ( routine# -- bool )  Calls a Standard File Package routine.
  115.     ?disable_actw
  116.     0  ^base  rot  
  117.     get: good  ;m
  118.  
  119. :m STDGET:  ( type0 ...typeN ) { #types -- bool } 
  120.     clear: fTypes  #types  0>
  121.     IF    #types 0  DO  add: fTypes  LOOP  THEN
  122.     SFloc  pack                    ¥ it's a Point, so has to be packed
  123.     0  0  #types  ixAddr: fTypes  0  ^base  SFGetFile
  124.     get: good  ;m
  125.  
  126.  
  127. :m STDPUT:  {  pAddr pLen nAddr nLen -- bool } 
  128.     pAddr pLen pad place
  129.     SFloc
  130.     pad  nAddr nLen  str255
  131.     0  ^base  SFPutFile
  132.     get: good  ;m
  133.  
  134. ;class 
  135.  
  136.  
  137. ¥ objHandle    SFHDL
  138. ¥ objPtr    SFOBJ   class_is  SFrec
  139.  
  140. (*    DO_OPEN does the hard work for OPEN: in File.  First, if either the DirID
  141.     or the vol ref# is non-zero, we rashly assume we know which folder we
  142.     want, and just do an open.  We also do that if we're not running under HFS.
  143.     Then, if we get through to here, we need to look at the paths.  But wait!
  144.     First, we check the default folder by just doing a plain open anyway!  If
  145.     this fails with a "file not found", we call ?USE_PATHS which either does
  146.     nothing (if we're not using a path designator file), or calls our PATHSMOD
  147.     module to look at a PD file and try using those paths to find the wanted
  148.     file.
  149. *)
  150.  
  151. : DO_OPEN  { perm -- rc }
  152.     1 ++> open_cnt
  153.     perm  ^base 27 + c!                ¥ set permission
  154.     ^base 48 + @                    ¥ DirID
  155.     ^base 22 + w@                    ¥ vol ref#
  156.     or                                ¥ Either non-zero?
  157.     use_paths? not  or                ¥ Or paths disabled?
  158.     IF                                ¥ Yes: just do a normal open, and get out.
  159.         ^base  PBOpenSync  EXIT
  160.     THEN
  161.                                     ¥ Maybe use HFS paths:
  162.     ^base PBOpenSync dup  0EXIT        ¥ Try default folder first
  163.                                     ¥ -- out if we found it
  164.     dup FNF <>  ?EXIT                ¥ If err wasn't FNF, get out
  165.     use_paths?  0EXIT                ¥ If paths disabled, out with FNF
  166.     drop  ^base perm open_with_paths
  167. ;
  168.  
  169.  
  170. SFRec    SFObj
  171.  
  172. :class   FILE    super{ object }        general
  173.  
  174. 136    bytes        FCB            ¥ max parameter block (108 but for hgetvinfo)
  175.                             ¥  then 4-byte align for PPC
  176.  
  177. 68k_record    FSSpec
  178. {    int            FSvRefNum
  179.     var            FSDirID
  180. 64    bytes        FileName
  181. }
  182.  
  183. :m CLEAR:        ¥ Clears the fcb, except for the filename.
  184.     ^base  18 erase  ^base 22 +  112 erase  ;m
  185.  
  186. :m SETNAMEPTR:    ¥ Sets filename pointer in the FCB.
  187.     ^base 142 +  ^base 18 + !  ;m
  188.  
  189. :m NAME:        ¥ ( addr len -- )  Assigns file name to fcb.  Rest cleared.
  190.     setNamePtr: self  clear: self
  191.     ^base 142 +  >r                    ¥ Addr of filename (at end of fcb)
  192.     r@  64 blanks
  193.     ( addr len )  64 min  r>  >str255  drop  ;m
  194.  
  195. :m SETDIRID:    ¥ ( dirid -- )  Sets the DirID for the fcb
  196.     ^base 48 +  !  ;m
  197.  
  198. :m GETDIRID:    ¥ ( -- dirid )  Gets the DirID for the fcb
  199.     ^base 48 +  @  ;m
  200.  
  201. :m GETFREF:    ¥ ( -- fref )  Gets the file ref number.
  202.     ^base 24 +  w@  ;m
  203.  
  204. :m SETFREF:
  205.     ^base 24 +  w!  ;m
  206.  
  207. :m SETVREF:    ¥ ( vref# -- )  Sets the volRefNum for the fcb
  208.     ^base 22 +  w!  ;m
  209.  
  210. :m GETVREF:    ¥ ( -- vref# )  Gets the volRefNum for the fcb
  211.     ^base 22 +  w@  ;m
  212.  
  213.  
  214. :m CLOSE:    ¥ ( -- rc )   Needs to clear the file RefNum field,
  215.             ¥ as advised in Mac Tech note # 102.  In fact we clear
  216.             ¥ the whole fcb except the name and Vref, so we can reuse
  217.             ¥ the fcb for a subsequent operation without the extra info
  218.             ¥ left by read and write calls being interpreted as HFS info.
  219.             
  220.     ^base  PBCloseSync  getVref: self  clear: self  setVref: self
  221.     dup if  1 ++> close_err_cnt  else  -1 ++> open_cnt  then  ;m
  222.  
  223.  
  224. :m OPEN:    ¥ ( -- rc )
  225.     0 do_open  ;m
  226.  
  227. :m OPENREADONLY:
  228.     1 do_open  ;m
  229.  
  230.  
  231. :m NEW:    ^base  PBCreateSync  ;m
  232.  
  233. :m DELETE:    ^base  PBDeleteSync  ;m
  234.  
  235. :m MOVETO:    ¥ ( byteoffset -- rc )  Positions relative to start of file
  236.     ^base  $ 2E +  !
  237.     ^base PBSetFPosSync  ;m
  238.  
  239. :m POS:        ¥ ( -- byteoffset )
  240.     inline{ ^base $ 2E + @}  ;m
  241.  
  242. :m SETEOF:    ¥ ( pos -- rc )  Sets end-of-file to absolute byte position
  243.     ^base 28 + !  ^base  PBSetEOFSync  ;m
  244.  
  245. :m CREATE:  { ¥ volID -- rc } 
  246.             ¥ Opens and resets file or creates new if not present.
  247.     1 ++> open_cnt
  248.     ^base  PBOpenSync            ¥ Attempt to open - don't use paths
  249.     ?dup
  250.     IF    dup FNF =
  251.         IF    drop
  252.             new: self  ?dup NIF  ^base  PBOpenSync  THEN
  253.         THEN
  254.     ELSE
  255.         0 setEOF: self
  256.     THEN  ;m
  257.  
  258. :m CREATENEW:    ¥ ( -- rc )  Like create:, but if file exists it's deleted
  259.                 ¥  and created totally new.
  260.     delete: self  drop
  261.     create: self  ;m
  262.  
  263. :m LAST:        ¥ Positions to end of file.
  264.     big# moveto: self  drop  ;m
  265.  
  266. :m SIZE:        ¥ ( -- #bytes )  Returns logical eof for file currently open
  267.     ^base  PBGetEOFSync  drop ^base 28 + @  ;m
  268.  
  269. :m BYTESREAD:    ¥ ( -- n )  Returns actual bytes read.
  270.     ^base 40 + @  ;m
  271.  
  272. :m FCB:  ( -- fcb )     ^base  ;m
  273.  
  274. :m RESULT:    ¥ ( -- rc )  Returns the last I/O result code.
  275.     ^base 16 + w@  ;m
  276.  
  277. :m MODE:        ¥ ( posMode -- )  Sets position mode
  278.     inline{ ^base 44 + w!}  ;m
  279.  
  280.  
  281. :m WAIT:    ¥ ( -- rc )  Waits for asynch I/O on this file to finish.
  282.     BEGIN    ^base busy =
  283.         NIF   ^base 16 + w@x  EXIT  THEN
  284.         pause
  285.     AGAIN  ;m
  286.  
  287. :m ?WAIT:    ¥ ( rc1 -- rc2 )
  288.     asynch?
  289.     NIF        drop  wait: self
  290.     ELSE    false -> asynch?
  291.     THEN   ;m
  292.  
  293.  
  294. :m READ:  { addr len -- rc }
  295.     0 mode: self
  296.     addr  ^base $ 20 + !
  297.     len      ^base $ 24 + !
  298.     ^base  PBReadSync  ;m
  299.  
  300. :m READLINE:  { addr maxLen -- rc }        ¥ Reads terminating with CR
  301.     $ 0D80 mode: self
  302.     addr      ^base $ 20 + !
  303.     maxLen    ^base $ 24 + !
  304.     ^base  PBReadSync  ;m
  305.  
  306. :m WRITE:  { addr len -- rc }
  307.     0 mode: self
  308.     addr  ^base $ 20 + !
  309.     len      ^base $ 24 + !
  310.     ^base  PBWriteSync  ;m
  311.  
  312. :m SETNAME:        ¥ Gets name from input stream, and assigns to fcb.
  313.                 ¥  The name can have embedded blanks and be delimited
  314.                 ¥  by " ... ", or just terminate at the end of line.
  315.  
  316.     bl skip-src+  & "  parse-word  name: self  ;m
  317.  
  318. :m GETNAME:        ¥ ( -- addr len )  Returns filename
  319.     addr: fileName  count  ;m
  320.  
  321. :m PRINT:        ¥ Prints the filename.
  322.     getName: self  type  ;m
  323.  
  324. :m GETFILEINFO:        ¥ ( -- rc )  Fills the parameter block with file info
  325.     ^base  PBHGetFInfoSync  ;m
  326.  
  327. :m SETFILEINFO:        ¥ ( -- rc )
  328.     ^base  PBHSetFInfoSync  ;m
  329.  
  330. :m SET:  { ftyp sig -- }            ¥ Sets file type, signature.
  331.     getDirID: self                    ¥ Save DirID
  332.     0 setDirID: self                ¥ and clear it (otherwise we'll get
  333.     getFileInfo: self  drop            ¥  "file not found")
  334.     sig  ^base  $ 24 +  !            ¥ Set signature
  335.     ftyp ^base  $ 20 +  !            ¥ Set type
  336.     0 setDirID: self
  337.     setFileInfo: self  drop
  338.     setDirID: self  ;m                ¥ Restore DirID
  339.  
  340.  
  341. ¥ :m DRIVE:    ¥ ( drive# -- )  set default drive to drive#
  342. ¥    clear: self  setVRef: self  ^base  PBSetVolSync
  343. ¥    IF 165 die  THEN  ;m
  344.  
  345. :m ACCEPT:  { addr len ¥ #chrs eof? -- #chrs eof? }     ¥ ACCEPTs from disk.
  346.     echo? IF  addr len erase  THEN            ¥ So the typed line is OK
  347.     addr len  readLine: self  -> eof?
  348.     bytesRead: self  eof? NIF  1-  THEN  -> #chrs
  349.     #chrs 0=  eof? and  IF  0  true  EXIT  THEN
  350.     addr #chrs +  c@  13 <>
  351.     IF                                ¥ Overlength line. Probably a comment.
  352.         BEGIN                        ¥ Gobble to CR or EOF
  353.             pad 100  readLine: self  -> eof?
  354.             eof?
  355.             IF        true
  356.             ELSE    pad  bytesRead: self  1-  +  c@ 13 =
  357.             THEN
  358.         UNTIL
  359.     THEN
  360.     #chrs -> len
  361.     echo?
  362.     IF    addr len type  cr  THEN
  363.     BEGIN                            ¥ Loop to convert tabs to blanks
  364.         addr len  9 scan  -> len  -> addr
  365.         len
  366.     WHILE
  367.         bl addr c!
  368.     REPEAT
  369.     #chrs  false   ;m
  370.  
  371.  
  372. :m RENAME: { taddr tlen -- rc } 
  373.     taddr tlen str255
  374.     ^base 28 + !  ^base  PBRenameSync  ;m
  375.  
  376.  
  377. :m GETTYPE:        ¥ ( -- type )
  378.     ^base 32 + @  ;m
  379.  
  380. :m FLUSHVOL:
  381.     ^base  PBFlushVolSync  drop  ;m
  382.  
  383.  
  384. :m CLASSINIT:
  385.     clear: self  setNamePtr: self  ;m
  386.  
  387.  
  388. ¥ Standard file package calls.  If the value SFDlgHook is non-zero, we take it as the
  389. ¥ address of a dialog hook routine.
  390.  
  391. private
  392.  
  393. :m SFPCALL:        ¥ ( various get? -- b )  Calls a Standard File Package routine
  394.     classinit: self                        ¥ Make sure name pointer is right
  395.     IF    stdGet: SFobj  ELSE  stdPut: SFobj  THEN
  396.     IF    getVRefNum: SFobj  clear: self  setVref: self
  397.         getName: SFobj  count  addr: fileName  place
  398.         true
  399.     ELSE
  400.         false
  401.     THEN
  402. ;m
  403.  
  404. public
  405.  
  406. :m STDGET:    ¥ ( type0 ...typeN #types -- bool )
  407.     true sfpCall: self  ;m
  408.  
  409. :m STDPUT:    ¥ ( pAddr pLen nAddr nLen -- bool )
  410.     false sfpCall: self  ;m
  411.  
  412. ;class 
  413.  
  414.  
  415. file FFCB
  416.  
  417. (*
  418. $ BC1F  ' ffcb 2-  w!
  419. ' file  ' ffcb 4+  reloc!x        ¥ Make fFcb a FILE objPtr
  420.  
  421. ' file    ffcb 8 -  reloc!x
  422. -4    fFcb 4 -    w!
  423. 2    ffcb 2 -    w!
  424. *)
  425.  
  426. ¥ GetDirID returns the dirID of the last directory opened by a
  427. ¥ standard file call.
  428.  
  429. syscall LMGetCurDirStore
  430.  
  431. : GETDIRID    LMGetCurDirStore  ;
  432.  
  433.  
  434. ¥ FileList keeps a stack of open load files for nested loads.
  435.  
  436. objPtr    TOPFILE  class_is  file
  437.  
  438.  
  439. :class     FILELIST  super{ handleArray } 
  440.  
  441. :m DROP:
  442.     top: super                        ¥ Give error if empty
  443.     close: topFile  drop
  444.     drop: super
  445.     size: super  NIF  nilP  ELSE  obj: self  THEN
  446.     -> topFile
  447.     false -> endload?   ;m
  448.  
  449. :m PUSHNEW:        ¥ Adds a new file to the stack
  450.     ['] file  pushNewObj: self
  451.     false -> endload?
  452.     obj: self  -> topFile            ¥ Note this locks the file object
  453.                                     ¥ -- this is what we want.
  454.     0 setVref: topFile   ;m
  455.  
  456. :m CLEAR:    ¥ Removes all currently open files
  457.     false -> endload?
  458.     get: size  0EXIT
  459.     ." File stack: "  cr  top: self
  460.     get: size
  461.     FOR        print: topFile  cr  drop: self
  462.     NEXT  ;m
  463.  
  464. ;class 
  465.  
  466.  
  467. 10    fileList    LOADFILE
  468.  
  469. 0    value        FILESTART_DP
  470. 0    value        CNT
  471. 0    value        SvLATEST
  472.  
  473. (*
  474. : LOGIT
  475.     state  0EXIT                    ¥ Out if we're not compiling
  476.     here filestart_DP -  pad w!
  477.     pos: topFile  src-len -
  478.     pad 2+  !
  479.     pad 6  add: $lg1  ;
  480.  
  481.  
  482. 0    value    LASTPOS
  483.  
  484. : LOGCR
  485.     state  0EXIT
  486.     here lastPos <=  ?EXIT
  487.     here -> lastPos
  488.     pad 14 erase
  489.     here filestart_DP -  pad w!
  490.     latest svLatest <> IF  true pad 4+ c!  latest -> svLatest  THEN
  491.     pad 14  add: $lg2  ;
  492. *)
  493.  
  494.  
  495. :f FREFILL        ¥ ( -- flag )  Does a refill from a file.
  496.     echo?
  497.     IF        ?pause
  498.     ELSE    cnt NIF  ?pause  20 -> cnt  else  1 --> cnt  THEN
  499.     THEN
  500. ¥    log? IF  logCR  THEN
  501.     tib tibLen  accept: topfile  ( #chrs eof? ) -> endload?  #tib !
  502.     set_source  endload? 0=
  503. ;f
  504.  
  505. : (fRefill)  fRefill  ;            ¥ for backwards compatibility
  506.  
  507.  
  508. : (LD)
  509.     BEGIN
  510.         endload? IF  false -> endload?  EXIT  THEN
  511.         topfile -> source-ID  Frefill  IF  interpret  THEN
  512.         state not  echo? and  fWind? and  IF  ." >"  THEN
  513.     AGAIN  ;
  514.  
  515.  
  516. false    value    DO_CR?
  517. false    value    marker_there?
  518.  
  519. : ?file_open_error  { OSErr -- }
  520.     OSErr  0EXIT                        ¥ out if no error
  521.     getName: topfile  type
  522.     OSErr FNF = IF  132 die  THEN        ¥ file not found
  523.     OSErr cr .  155 die                    ¥ other error opening file
  524. ;
  525.  
  526.  
  527. : BL>01        ¥ ( addr len -- )  Replaces blanks with 01's in the string.
  528.     bounds
  529.     ?DO        i c@  bl = IF  $ 01  i c!  THEN
  530.     LOOP
  531. ;
  532.  
  533. : 01>BL        ¥ ( addr len -- )  Replaces 01's with blanks in the string.
  534.     bounds
  535.     ?DO        i c@  $ 01 = IF  bl  i c!  THEN
  536.     LOOP
  537. ;
  538.  
  539.  
  540. : FNAME>MNAME    ¥ ( addr len -- )    Takes the passed-in filename, and converts it to
  541.                 ¥  the corresponding file marker name in $marker.
  542.  
  543.     new: $marker  put: $marker
  544.     & :  <chsearch: $marker  negate skip: $marker
  545.     <step: $marker  delete: $marker
  546.     all: $marker bl>01            ¥ replace any blanks
  547.     begin: $marker  " m__" insert: $marker        ¥ prepend "m__"
  548.     reset: $marker
  549. ;
  550.  
  551. : MNAME>FNAME    ¥ ( addr len -- )    Takes the passed-in marker name, and
  552.                 ¥  converts it to  the corresponding filename in  $marker.
  553.     3 /string                                ¥ skip the "m__"
  554.     new: $marker  put: $marker  all: $marker 01>bl    ¥ and recover any blanks
  555.     reset: $marker
  556. ;
  557.  
  558. 0    value    mk_cfa
  559.  
  560. : mark_file  ( addr len -- )
  561.     " marker" sFind nip NIF 2drop EXIT THEN        ¥ out if MARKER not defined yet
  562.     fname>mname
  563.     begin: $marker  " marker " insert: $marker
  564.     lock: $marker  all: $marker  evaluate
  565.     release: $marker
  566.     true -> marker_there?
  567.     CDP 10 -  -> mk_cfa        ¥ markers have 2 spare bytes at the cfa,
  568.     1 mk_cfa w!                ¥  so we store 1 there to show this is a file
  569.                             ¥  mark
  570. ;
  571.  
  572.     
  573. : LOADTOP  {  ¥ svCurs svDP svCDP svDepth len rc -- } 
  574.                             ¥ Interprets the file as a Mops source file.
  575.     openReadOnly: topfile  ?file_open_error
  576.  
  577.     marker_there?  false -> marker_there?
  578.     IF
  579.         getFileInfo: topfile -> rc
  580.         topFile 48 + @  code,            ¥ put source dirID after marker info
  581.                                         ¥  at offs 10 from cfa
  582.         topFile 76 + @  code,            ¥ then the mod date at offs 14
  583.         getName: topfile                ¥ this will be the full pathname
  584.         dup -> len
  585.         CDP place  len 1+ ++> CDP        ¥ store it after the mod date,
  586.                                         ¥  at offs 18
  587.         code_align
  588.  
  589.     ¥ now for some mysterious reason, if we've just saved the file
  590.     ¥  in Quick Edit and we get the file info, we get EOF the first time
  591.     ¥  we try to read from it.  So we'll do a dummy read, then close
  592.     ¥  and re-open it.
  593.     
  594.         pad 1  read: topfile  drop  close: topfile  drop
  595.         openReadOnly: topfile  ?file_open_error
  596.     THEN
  597.     
  598.     curs? -> svCurs  -curs
  599.     cr
  600.     size: loadFile 2*  spaces  ." Loading: " 
  601.     getName: topfile  type
  602.  
  603.     DP -> svDP  CDP -> svCDP  depth -> svDepth
  604.     false -> endload?  false -> do_cr?
  605.     (ld)
  606.     close: topfile  drop
  607.     do_cr?
  608.     IF  cr  size: loadFile 2*  ELSE  2  THEN  spaces  true -> do_cr?
  609.     ." Code: "
  610.     CDP 
  611.     svCDP IF  svCDP  ELSE  code_start  THEN  -  .
  612.     DP  svDP  -  ."   data: "  .
  613.     size: loadFile 1 <= IF  cr  THEN
  614.     depth svDepth <> IF  cr ." Warning - stack depth changed" cr  THEN
  615.     svCurs -> curs?
  616. ;
  617.  
  618.  
  619. : ENDLOAD        true -> endload?  0 -> src-len  ;    ppc_only
  620.  
  621.  
  622. ¥ Nesting loader.  Usage: // filename
  623.  
  624.  
  625. : (load)
  626.     room2            ¥ ( -- code-room data-room )
  627.     512  < IF  204 die  THEN        ¥ bail out on insufficient free space
  628.     1024 < IF  203 die  THEN
  629.     getName: topfile  mark_file
  630.     loadTop
  631.     drop: loadFile
  632. ;
  633.  
  634. : //
  635.     pushNew: loadFile  setName: topFile
  636.     (load)
  637. ;            ppc_only
  638.  
  639.  
  640. : INCLUDED  { addr len -- }        ¥ loads the named file, if not loaded already
  641.     addr len  fname>mname
  642.     all: $marker  sfind  nip
  643.     IF  release: $marker  EXIT  THEN        ¥ Found - nothing else to do
  644.     pushNew: loadFile
  645.     addr len  name: topFile
  646.     (load)
  647. ;
  648.  
  649.  
  650. : NEED  ( --<filename> )
  651.     word"  count                ¥ Get name from input
  652.     included  ;
  653.  
  654.     
  655.  
  656. ¥ CL2 is the next cleanup word - it cleans up all file stuff on abort,
  657. ¥ as well as whatever we were doing before (see CL1 in file Class).
  658.  
  659. : NOMOD
  660.     -1 -> modcode  -1 -> moddata
  661. ¥    -1 -> modcode_start  -1 -> modcode_limit
  662. ¥    -1 -> moddata_start  -1 -> moddata_limit
  663.     -1 -> modcode_comp_start
  664.     -1 -> moddata_comp_start
  665.     0 -> compmod  0 -> comp_seg#
  666. ;
  667.  
  668. : clFiles
  669.     clear: loadfile  close: ffcb drop
  670.     nilP -> topfile
  671.     nomod
  672. ¥    release: $lg1  release: $lg2
  673. ¥    ['] null  -> logvec
  674.     false -> endload?
  675.     false -> savingDic?
  676. ;
  677.  
  678.  
  679. : filinit
  680. ¥    fFcb 18 + @                ¥ Name pointer - doc name may not be in fFcb
  681. ¥    count  32 min  myDocName place
  682.     classinit: loadfile  nilP -> topfile
  683.     false -> MRopen?
  684. ;
  685.  
  686.  
  687. ¥ ' filinit    -> objinit        - filinit now called from init1 in cg7
  688. ¥ ' clFiles    -> abortvec
  689.